home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
amok_lha
/
amok03.lha
/
IFFLoad_1.1
/
IFFLoad.mod
< prev
next >
Wrap
Text File
|
1993-08-15
|
23KB
|
657 lines
(*---------------------------------------------------------------------------
:Program. IFFLoad.mod
:Author. Fridtjof Siebert
:Address. Nobileweg 67, D-7-Stgt-40
:Phone. 0711/822509
:Shortcut. [fbs]
:Version. 1.1
:Date. 20-May-88
:Copyright. Shareware or PD, anyway you like. (I like Shareware better)
:Language. Modula-II
:Translator. M2Amiga
:Imports. LoadBody.asm [fbs]
:UpDate. 07-Jun-88: Maschinensprachteil [fbs]
:Contents. Schnelle Ladeprozedur für IFF (ILBM)-Bilder.
:Remark. Let's wave! The Cure. The Mission. Sisters of Mercy !!!
---------------------------------------------------------------------------*)
IMPLEMENTATION MODULE IFFLoad;
FROM SYSTEM IMPORT ADR, ADDRESS, SHIFT, BITSET, LONGSET, CAST, INLINE,
REG;
FROM Exec IMPORT AllocMem, FreeMem, MemReqs, MemReqSet, UByte,
Interrupt, AddIntServer, RemIntServer, NodeType;
FROM Dos IMPORT FileHandlePtr, Open, Close, Read, oldFile;
FROM Intuition IMPORT NewScreen, ScreenPtr, OpenScreen, CloseScreen,
ScreenToBack, ScreenFlags, ScreenFlagSet,
customScreen, MoveScreen, WindowPtr, OpenWindow,
CloseWindow, IDCMPFlags, IDCMPFlagSet, WindowFlags,
WindowFlagSet;
FROM Graphics IMPORT SetRGB4, RastPortPtr, BitMapPtr, ViewModes,
ViewModeSet, BitMap, InitBitMap, AllocRaster,
BltClear, FreeRaster, ViewPortPtr;
FROM GfxMacros IMPORT OffDisplay, OnDisplay;
FROM Hardware IMPORT vertb;
FROM Arts IMPORT TermProcedure, Assert;
FROM Strings IMPORT Compare, first, last;
FROM LoadBody IMPORT LoadBody;
(*---------------------------------------------------------------------------
! !
! Variables from Definition: !
! !
-----------------------------------------------------------------------------
(*--------------------------- Types: ------------------------------------*)
TYPE
IFFTitles = (BMHD,CMAP,GRAB,DEST,CAMG,CRNG,BODY,SPRT,CCRT,CMHD,DPPV);
IFFTitleSet = SET OF IFFTitles;
(* SPRT,CCRT,CMHD,DPPV not implemented !!! *)
ViewTypes = (vt0,Ersy,Lace,LPen,vt4,vt5,vt6,vt7,Gaud,Color,DblPF,HoMod,
vt12,vt13,vt14,Hires,v16);
ViewTypeSet = SET OF ViewTypes;
(* which ViewModes are selected *)
TYPE
(*------------- The Structure that keeps all the data: ------------------*)
(* You don't have to understand all variables in this structure! Only some *)
(* are important, like BMHD.width/height or CMAP.red[] etc. The other data *)
(* is used by the Routines that are exported from this module,like DoCycle *)
(* etc. *)
IFFInfoTypePtr = POINTER TO IFFInfoType;
IFFInfoType = RECORD
(* This contains all Data needed for a Picture *)
(*------ Which Data is availble: ------*)
IFFTitle: IFFTitleSet; (* all Sub-Records, whose equally named Flag*)
(* is set here, contain readable data *)
(*------ Information on BitMap: ------*)
BMHD: RECORD
width,height: INTEGER; (* the Picture's Size *)
depth: UByte; (* it's Depth (how many BitPlanes) *)
left,top: INTEGER; (* it's Location *)
masking: UByte; (* Masking (see Documentation) *)
transCol: INTEGER; (* Transparent Color *)
xAspect,yAspect: UByte; (* Verzerrung *)
scrnWidth,scrnHeight: INTEGER; (* The Image's Screen's Size *)
END;
(*------ Information on Colors: ------*)
CMAP: RECORD
colorCnt: CARDINAL; (* Number of Colors used *)
red,green,blue: ARRAY[0..63] OF UByte;
(* the Colors (I hope for 6 Bitplanes to be possible anytime) *)
END;
(*------ Information on HotSpot: ------*)
GRAB: RECORD
hotX,hotY: INTEGER; (* Hot-Spot of this Image (if exists *)
END;
(*------ Information on Destination-Bitmap: ------*)
DEST: RECORD
depth: UByte; (* number of Planes *)
planePick: CARDINAL;
planeOnOff: CARDINAL; (* set or clear other Planes ? *)
planeMask: CARDINAL; (* planes to be changed *)
END;
(*------ Information on any Special ViewMode: ------*)
CAMG: RECORD
viewType: ViewTypeSet; (* ViewMode *)
END;
(*------ Information on ColorCycling: ------*)
CRNG: RECORD
count: CARDINAL; (* Number of ColorCyclings *)
data: ARRAY[0..15] OF RECORD
rate: INTEGER; (* velocity, 800H is 60 per second *)
on: BOOLEAN; (* decide, wether CRNG is active or not *)
forward: BOOLEAN; (* Direction (DPaint) *)
low,high: UByte; (* lower and upper Color of this Range *)
END;
END;
(*------ Internal Information: ------*)
Internal: RECORD
CycleID: CARDINAL; (* that's to distinguish different cyclings *)
END;
END;
(* That's been quite a complex Variable. If you wanna use it, do it this *)
(* way: *)
(* e.g. You wanna know, how Deep your Image is. Ça marche comme ça: *)
(* MyDepth := IFFInfo.BMHD.depth; *)
(* You can get the speed of the second Colorcycle this way: *)
(* speed := IFFInfo.CRNG.data[2].rate; *)
(*-------------- That's the Variable, that contains all Data ------------*)
(* this should be imported to your Module to get the Data. Don't forget to *)
(* save the data, e.g. to a variable of the same type. Everytime you load *)
(* a new IFF-File, the data is scratched !!! (i.e. the new data is written *)
(* into this structure.) *)
VAR
IFFInfo: IFFInfoType;
(*-------------------- The NewScreen-Structure. -------------------------*)
(* this can be used to open the Screen, if dontopen is specified *)
VAR
NuScreen: NewScreen;
(*-------------------- The NewWindow-Structure. -------------------------*)
(* this can be used to open the Window later. Don't forget to put Screen- *)
(* Ptr in NuWindow.screen !!! *)
VAR
NuWindow: NewWindow;
*)
(*-------------------------------------------------------------------------*)
(* *)
(* Internal Variables and Types: *)
(* *)
(*-------------------------------------------------------------------------*)
CONST
MOVEMS = 48E7H; (* that's the 68000-Instruction MOVEM to save Registers*)
MOVEML = 4CDFH; (* that's MOVEM to load Registers *)
TYPE
CyclingInfo = RECORD
int: Interrupt; (* The Cycling's Interrupt *)
VP: ViewPortPtr; (* The Cycling's ViewPort *)
count: ARRAY[0..15] OF CARDINAL; (* counts Cycling-Positions *)
speedCnt: ARRAY[0..15] OF CARDINAL; (* counts Speed *)
(* The Cycling-Direction (TRUE=Forwards) *)
END;
VAR
InH: FileHandlePtr;
i,j,k: LONGINT;
length: INTEGER;
LineLength: LONGINT; (* Bytes per Image-Line *)
LineWidth: LONGINT; (* Bytes per Screen-Line *)
BM: BitMapPtr;
Compression: BOOLEAN; (* Decide, wether data is compressed or not *)
MaskPlane: BOOLEAN; (* Is there a Mask-Plane ?? *)
Buffer: ADDRESS;
TextBuffer: POINTER TO ARRAY[0..63] OF ARRAY[0..3] OF CHAR;
LONGBuffer: POINTER TO ARRAY[0..63] OF LONGCARD;
WORDBuffer: POINTER TO ARRAY[0..127] OF INTEGER;
BYTEBuffer: POINTER TO ARRAY[0..255] OF UByte;
len: LONGINT;
BitMaps: ARRAY[0..5] OF ADDRESS;
Byte,Byte2: UByte;
Line,Plane: LONGINT;
Location,Right: POINTER TO UByte;
RQPos,RQLen: LONGCARD;
RQBuffer: POINTER TO ARRAY[0..511] OF UByte;
SpecialView: LONGSET;
Exit: BOOLEAN;
NoErr: BOOLEAN;
CycleInfos: ARRAY[0..31] OF CyclingInfo;
IntInfo: IFFInfoTypePtr;
IntNum: CARDINAL;
IntCount,IntCount2,IntCount3: CARDINAL;
(*----------- Procedure called by machinecode to get Data: --------------*)
PROCEDURE Read512();
BEGIN
len := Read(InH,RQBuffer,512);
END Read512;
(*-------------------------------------------------------------------------*)
(* *)
(* R e a d I L B M : *)
(* *)
(*-------------------------------------------------------------------------*)
(*
TYPE
ReadILBMFlags = (front,visible,dontopen,window);
ReadILBMFlagSet = SET OF ReadILBMFlags;
*)
PROCEDURE ReadILBM(name: ARRAY OF CHAR; Flags: ReadILBMFlagSet;
VAR Screen: ScreenPtr; VAR Window: WindowPtr): BOOLEAN;
(* ReadILBM() lädt ein IFF-Bild und öffnet das geladene Bild als Screen. *)
(* Name: The IFF-Filename *)
(* Flags: *)
(* -front: decides whether Screen is first or last one while loading *)
(* -visible: decides if display should be turned off (that's faster) *)
(* -dontopen: avoids to open the Screen. The Returned value is NIL. The *)
(* BitMap of the loaded Imagery can be found in NuScreen.customBitMap. *)
(* Don't forget to free the image's Memory if it's no more needed and *)
(* the Memory needed for the BitMap-Structure. *)
(* -window: if set, an Window of the same size as the Image is opened. *)
(* So, Gadgets etc. can be added to it. *)
(* Screen: Pointer to Screen-structure of opened Screen *)
(* Window: Pointer to the opened Window or NIL if window isn't set. *)
(* Result: FALSE if error occured. Then there's no Screen opened. *)
PROCEDURE OpenScrn();
(* this initializes the Screen, Window and Bitmap, if they're needed. *)
(* Screen and Window are opened. *)
BEGIN
WITH NuScreen DO
width := IFFInfo.BMHD.scrnWidth;
IF width<IFFInfo.BMHD.width THEN
width := IFFInfo.BMHD.width;
END;
height := IFFInfo.BMHD.scrnHeight;
IF height<IFFInfo.BMHD.height THEN
height := IFFInfo.BMHD.height;
END;
leftEdge := IFFInfo.BMHD.left;
topEdge := IFFInfo.BMHD.top;
depth := IFFInfo.BMHD.depth;
viewModes := ViewModeSet{};
IF (width>400) AND (depth<5) THEN INCL(viewModes,hires) END;
IF height>300 THEN INCL(viewModes,lace) END;
IF Lace IN IFFInfo.CAMG.viewType THEN INCL(viewModes,lace ) END;
IF HoMod IN IFFInfo.CAMG.viewType THEN INCL(viewModes,ham ) END;
IF Hires IN IFFInfo.CAMG.viewType THEN INCL(viewModes,hires ) END;
IF DblPF IN IFFInfo.CAMG.viewType THEN INCL(viewModes,dualpf) END;
IF (ViewTypeSet{} = (ViewTypeSet{DblPF,HoMod} * IFFInfo.CAMG.viewType))
AND (depth=6) THEN
INCL(viewModes,extraHalfbrite);
END;
detailPen := 0; blockPen := 0;
type := customScreen+ScreenFlagSet{screenQuiet};
font := NIL;
defaultTitle := NIL;
gadgets := NIL;
customBitMap := NIL;
IF NOT(front IN Flags) THEN topEdge := 600 END;
END;
IF dontopen IN Flags THEN
INCL(NuScreen.type,customBitMap);
WITH NuScreen DO
customBitMap := AllocMem(SIZE(BitMap),MemReqSet{public});
InitBitMap(customBitMap^,depth,width,height);
i:=0;
REPEAT
customBitMap^.planes[i] := AllocRaster(width,height);
BitMaps[i] := customBitMap^.planes[i];
IF BitMaps[i]=NIL THEN
NoErr:=FALSE
ELSE
BltClear(BitMaps[i],width DIV 8 * height,0);
END;
INC(i);
UNTIL (i=depth) OR NOT(NoErr);
IF NOT(NoErr) THEN (* error: give allocated Mem back: *)
WHILE i>1 DO
DEC(i);
FreeRaster(BitMaps[i],width,height);
END;
END;
END;
ELSE
Screen := OpenScreen(NuScreen);
IF Screen=NIL THEN
NoErr := FALSE;
ELSE
IF NOT(front IN Flags) THEN
ScreenToBack(Screen);
MoveScreen(Screen,0,-600);
END;
BM := Screen^.rastPort.bitMap;
FOR i:=0 TO NuScreen.depth-1 DO
BitMaps[i] := BM^.planes[i];
END;
WITH IFFInfo.CMAP DO
FOR i:=0 TO colorCnt-1 DO
SetRGB4(ADR(Screen^.viewPort),i,red[i],green[i],blue[i]);
END;
END;
END;
END;
WITH NuWindow DO
leftEdge := 0;
topEdge := 0;
width := IFFInfo.BMHD.width;
height := IFFInfo.BMHD.height;
detailPen := 1;
blockPen := 0;
idcmpFlags := IDCMPFlagSet{};
flags := WindowFlagSet{borderless,noCareRefresh};
firstGadget := NIL;
checkMark := NIL;
title := NIL;
screen := Screen;
bitMap := NIL;
type := customScreen;
END;
IF (window IN Flags) AND (Screen#NIL) THEN
Window := OpenWindow(NuWindow);
IF Window=NIL THEN
CloseScreen(Screen);
Screen := NIL;
NoErr := FALSE;
END;
END;
IF NOT(visible IN Flags) THEN OffDisplay() END;
END OpenScrn;
PROCEDURE ReadQuick(To: ADDRESS; Count: CARDINAL);
VAR
ToPtr: POINTER TO ARRAY[0..9999] OF UByte;
i: CARDINAL;
BEGIN
ToPtr := To;
i := 0;
REPEAT
IF RQPos=RQLen THEN
RQLen := Read(InH,RQBuffer,512);
RQPos := 0;
END;
ToPtr^[i] := ORD(RQBuffer^[RQPos]);
INC(RQPos); INC(i);
UNTIL i=Count;
END ReadQuick;
BEGIN
IFFInfo.IFFTitle := IFFTitleSet{};
IF NOT(visible IN Flags) THEN OffDisplay() END;
NoErr := TRUE; Screen := NIL; Window := NIL;
RQPos := 0; RQLen := 0;
InH := Open(ADR(name),oldFile);
IF InH=NIL THEN NoErr := FALSE END;
IF NoErr THEN
(*------ File Header: ------*)
len := Read(InH,Buffer,12);
IF (len=NIL) OR (Compare(TextBuffer^[0],first,4,"FORM",TRUE)#0) OR
(Compare(TextBuffer^[2],first,4,"ILBM",TRUE)#0) THEN NoErr := FALSE END;
Exit := FALSE;
(*------ Main Loop: ------*)
WHILE NoErr AND NOT(Exit) DO
len := Read(InH,Buffer,4);
(*------ BMHD: ------*)
IF Compare(TextBuffer^[0],first,4,"BMHD",TRUE)=0 THEN
INCL(IFFInfo.IFFTitle,BMHD);
len := Read(InH,Buffer,4);
len := Read(InH,Buffer,LONGBuffer^[0]);
WITH IFFInfo.BMHD DO
width := WORDBuffer^[0];
height := WORDBuffer^[1];
left := WORDBuffer^[2];
top := WORDBuffer^[3];
depth := BYTEBuffer^[8];
masking := BYTEBuffer^[9];
MaskPlane := masking=1;
Compression := BYTEBuffer^[10]=1;
transCol := WORDBuffer^[6];
xAspect := BYTEBuffer^[14];
yAspect := BYTEBuffer^[15];
scrnWidth := WORDBuffer^[8];
scrnHeight:= WORDBuffer^[9];
END;
(*------ CMAP: ------*)
ELSIF Compare(TextBuffer^[0],first,4,"CMAP",TRUE)=0 THEN
INCL(IFFInfo.IFFTitle,CMAP);
len := Read(InH,Buffer,4);
i := LONGBuffer^[0];
len := Read(InH,Buffer,i);
WITH IFFInfo.CMAP DO
colorCnt := i DIV 3;
j := 0;
FOR k:=0 TO colorCnt DO
red [k] := SHIFT(BYTEBuffer^[j ],-4);
green[k] := SHIFT(BYTEBuffer^[j+1],-4);
blue [k] := SHIFT(BYTEBuffer^[j+2],-4);
INC(j,3);
END;
INC(colorCnt);
END;
(*------ CAMG: ------*)
ELSIF Compare(TextBuffer^[0],first,4,"CAMG",TRUE)=0 THEN
INCL(IFFInfo.IFFTitle,CAMG);
len := Read(InH,Buffer,8);
IFFInfo.CAMG.viewType := CAST(ViewTypeSet,LONGBuffer^[1]);
(*------ GRAB: ------*)
ELSIF Compare(TextBuffer^[0],first,4,"GRAB",TRUE)=0 THEN
INCL(IFFInfo.IFFTitle,GRAB);
len := Read(InH,Buffer,8);
IFFInfo.GRAB.hotX := WORDBuffer^[2];
IFFInfo.GRAB.hotY := WORDBuffer^[3];
(*------ DEST: ------*)
ELSIF Compare(TextBuffer^[0],first,4,"DEST",TRUE)=0 THEN
INCL(IFFInfo.IFFTitle,DEST);
len := Read(InH,Buffer,12);
WITH IFFInfo.DEST DO
depth := BYTEBuffer^[4];
planePick := WORDBuffer^[3];
planeOnOff := WORDBuffer^[4];
planeMask := WORDBuffer^[5];
END;
(*------ CRNG: ------*)
ELSIF Compare(TextBuffer^[0],first,4,"CRNG",TRUE)=0 THEN
IF NOT(CRNG IN IFFInfo.IFFTitle) THEN
IFFInfo.CRNG.count := 0;
END;
INCL(IFFInfo.IFFTitle,CRNG);
len := Read(InH,Buffer,12);
WITH IFFInfo.CRNG.data[IFFInfo.CRNG.count] DO
rate := WORDBuffer^[3];
on := 0 IN CAST(BITSET,WORDBuffer^[4]);
forward := NOT(1 IN CAST(BITSET,WORDBuffer^[4]));
low := BYTEBuffer^[10];
high := BYTEBuffer^[11];
(* this line is only to identify illegal data, that some IFF-Files contain:*)
on := on AND (low<IFFInfo.CMAP.colorCnt)
AND (high<IFFInfo.CMAP.colorCnt);
END;
INC(IFFInfo.CRNG.count);
(*------ BODY: ------*)
ELSIF Compare(TextBuffer^[0],first,4,"BODY",TRUE)=0 THEN
OpenScrn();
IF NoErr THEN
len := Read(InH,Buffer,4);
LineLength := SHIFT(SHIFT(CAST(INTEGER,CAST(BITSET,
IFFInfo.BMHD.width+15) * {4..15}),-4),1);
LineWidth := SHIFT(NuScreen.width,-3);
IF Compression THEN
(*------ let's load the BitMap's Data: ------*)
LoadBody(Read512, RQBuffer, ADR(BitMaps[0]), LineLength,
LineWidth, IFFInfo.BMHD.height, NuScreen.depth,
MaskPlane); (* this does all the work very quickly *)
ELSE (* not compressed *)
(*------ to load uncompressed Images is less time-critical: *)
FOR Line := 0 TO IFFInfo.BMHD.height-1 DO
FOR Plane := 0 TO NuScreen.depth-1 DO
ReadQuick(BitMaps[Plane]+ LineWidth*Line,LineLength);
END;
IF MaskPlane THEN
ReadQuick(Buffer,LineLength);
END;
END;
END;
END; (* IF NoErr *)
Exit := TRUE;
(*------ Ignore unknown data: ------*)
ELSE
len := Read(InH,Buffer,4);
i := LONGBuffer^[0];
WHILE i>256 DO
len := Read(InH,Buffer,256);
DEC(i,256);
END;
len := Read(InH,Buffer,i);
END;
END; (* WHILE NOT(Exit DO *)
END; (* IF NoErr *)
IF InH#NIL THEN Close(InH); InH := NIL; END;
IF NOT(NoErr) THEN
IF Window#NIL THEN CloseWindow(Window) END;
IF Screen#NIL THEN CloseScreen(Screen) END;
END;
OnDisplay();
RETURN NoErr;
END ReadILBM; (* that's it *)
(*--------------- Procedures for ColorCycling: --------------------------*)
PROCEDURE CycleInterrupt();
BEGIN
INLINE(MOVEMS,3F3EH);
IntInfo := ADDRESS(REG(9));
IF CRNG IN IntInfo^.IFFTitle THEN
IntNum := IntInfo^.Internal.CycleID;
WITH CycleInfos[IntNum] DO
IntCount := 0;
WHILE IntCount<IntInfo^.CRNG.count DO
WITH IntInfo^.CRNG.data[IntCount] DO
IF on THEN
INC(speedCnt[IntCount],rate);
IF speedCnt[IntCount]>=4000H THEN
(* this 4000H should have been 8000H, but then it's to slow. *)
(* dont know why, but this way, it works correctly *)
DEC(speedCnt[IntCount],4000H);
IF forward THEN
IF count[IntCount]<=low THEN
count[IntCount]:=high;
ELSE
DEC(count[IntCount]);
END;
ELSE
IF count[IntCount]>=high THEN
count[IntCount]:=low;
ELSE
INC(count[IntCount]);
END;
END;
IntCount3 := count[IntCount];
IntCount2 := low;
WHILE IntCount2<=high DO
SetRGB4(VP,IntCount2,IntInfo^.CMAP.red[IntCount3],
IntInfo^.CMAP.green[IntCount3],
IntInfo^.CMAP.blue[IntCount3]);
INC(IntCount3);
IF IntCount3>high THEN IntCount3:=low END;
INC(IntCount2);
END;
END;
END;
END;
INC(IntCount);
END;
END;
END;
INLINE(MOVEML,7CFCH);
END CycleInterrupt;
PROCEDURE DoCycle(Info: IFFInfoTypePtr; Screen: ScreenPtr): BOOLEAN;
(* this creates an interrupt, that does cycling. You needn't worry, *)
(* whether there's cycling data or not. Don't forget to call EndCycle to *)
(* remove the Cycling-Interrupt !!! *)
(* If result is false, any error occured. Don't call EndCycle in this case!*)
BEGIN
i:=0;
LOOP
IF CycleInfos[i].VP=NIL THEN EXIT END;
INC(i);
IF i=32 THEN RETURN FALSE END;
END;
Info^.Internal.CycleID := i;
WITH CycleInfos[i] DO
VP := ADR(Screen^.viewPort);
IF CRNG IN Info^.IFFTitle THEN
FOR j:=0 TO Info^.CRNG.count-1 DO
count[j] := Info^.CRNG.data[j].low;
speedCnt[j] := 0;
END;
END;
WITH int DO
node.type := interrupt;
node.pri := -60;
node.name := NIL;
data := Info;
code := ADR(CycleInterrupt);
END;
AddIntServer(vertb,ADR(int));
END;
RETURN TRUE;
END DoCycle;
PROCEDURE EndCycle(Info: IFFInfoTypePtr);
(* remove cycling-Interrupt *)
BEGIN
i := Info^.Internal.CycleID;
RemIntServer(vertb,ADR(CycleInfos[i].int));
CycleInfos[i].VP := NIL;
END EndCycle;
(*------------------------ TermProcedure: -------------------------------*)
PROCEDURE CleanUp();
BEGIN
IF InH#NIL THEN Close(InH) END;
FreeMem(Buffer,768);
END CleanUp;
(*----------------------- Initialization: -------------------------------*)
BEGIN
Buffer := AllocMem(768,MemReqSet{chip,memClear});
Assert(Buffer#NIL,ADR("Not enough ChipMem !!!"));
TextBuffer := Buffer;
LONGBuffer := Buffer;
WORDBuffer := Buffer;
BYTEBuffer := Buffer;
RQBuffer := ADDRESS(Buffer+256);
InH := NIL;
FOR i:=0 TO 31 DO CycleInfos[i].VP:=NIL END;
TermProcedure(CleanUp);
END IFFLoad.